#| echo: false
#| warning: false
#| message: false
#| fig-height: 900
library(tidyverse)
library(plotly)
library(viridis)
# 1. DATOS (Los mismos de la imagen panorámica)
data_etnias_full <- tribble(
~Etnia, ~`2019`, ~`2020`, ~`2021`, ~`2022`, ~`2023`, ~`2024`, ~`2025`,
"Achuar", 7, 5, 6, 11, 11, 30, 14,
"Afroperuano", 0, 4, 0, 3, 0, 2, 0,
"Aimara", 10, 10, 7, 6, 8, 4, 5,
"Amahuaca", 5, 13, 1, 7, 2, 1, 3,
"Arabela", 1, 8, 2, 1, 1, 0, 1,
"Ashaninka", 9, 10, 39, 83, 36, 76, 31,
"Asheninka", 0, 2, 7, 15, 14, 16, 8,
"Awajún", 262, 219, 434, 434, 155, 424, 281,
"Bora", 3, 2, 2, 2, 1, 1, 6,
"Capanahua", 0, 1, 1, 0, 0, 0, 0,
"Cashinahua", 1, 2, 0, 7, 3, 0, 1,
"Chapra", 0, 1, 0, 0, 0, 1, 3,
"Chitonahua", 0, 0, 0, 0, 0, 3, 4,
"Ese Eja", 0, 1, 0, 5, 2, 0, 0,
"Harakbut", 0, 1, 0, 1, 2, 0, 0,
"Iñapari", 0, 0, 0, 0, 0, 1, 2,
"Jaqaru", 1, 0, 0, 0, 0, 4, 2,
"Jíbaro", 0, 0, 0, 0, 0, 3, 1,
"Kakinte", 0, 0, 0, 0, 0, 0, 2,
"Kakataibo", 0, 5, 0, 0, 0, 1, 0,
"Kandozi", 2, 0, 3, 4, 1, 10, 5,
"Kichwa", 2, 19, 3, 9, 1, 60, 74,
"Kukama Kukamiria", 23, 1, 16, 20, 8, 12, 6,
"Madija", 6, 0, 8, 14, 2, 0, 1,
"Maijuna", 2, 0, 0, 0, 1, 0, 2,
"Matsés", 0, 0, 0, 0, 0, 1, 1,
"Matsigenka", 0, 0, 0, 2, 0, 0, 0,
"Murui-Muinani", 0, 2, 0, 4, 0, 2, 0,
"Nahua", 1, 1, 0, 1, 2, 0, 0,
"Nanti", 0, 0, 0, 0, 2, 0, 1,
"Nomatsigenga", 0, 0, 6, 0, 0, 0, 1,
"Quechuas", 15, 1, 1, 2, 0, 0, 1,
"Sharanahua", 26, 15, 0, 43, 23, 41, 46,
"Shawi", 0, 1, 0, 3, 0, 5, 1,
"Shipibo-Konibo", 6, 7, 27, 9, 2, 21, 24,
"Shiwilu", 0, 14, 3, 33, 20, 19, 25,
"Tikuna", 16, 0, 7, 1, 0, 4, 0,
"Urarina", 0, 0, 8, 0, 1, 1, 3,
"Wampis", 1, 0, 0, 0, 1, 1, 2,
"Yagua", 2, 1, 2, 36, 5, 25, 26,
"Yaminahua", 0, 2, 1, 5, 0, 1, 2,
"Yanesha", 0, 2, 74, 3, 0, 1, 0,
"Yine", 0, 0, 0, 1, 1, 6, 4
)
# 2. PROCESAMIENTO
# Necesitamos formato largo para el Heatmap
plot_data_heatmap <- data_etnias_full %>%
pivot_longer(cols = `2019`:`2025`, names_to = "Año_Texto", values_to = "Casos") %>%
mutate(
Año = as.numeric(Año_Texto),
# Calculamos el total por etnia para ordenar el gráfico (Las que tienen más casos, arriba)
Total_Por_Etnia = ave(Casos, Etnia, FUN = sum),
# --- EL TRUCO PARA EL COLOR ---
# Creamos una columna específica para pintar.
# Si Casos es 0, ponemos NA (para que no se pinte).
# Si es > 0, mantenemos el número.
Casos_Fill = ifelse(Casos == 0, NA, Casos),
# Tooltip: Usamos la columna original 'Casos' para que muestre "0" y no "NA"
Tooltip_Text = paste0("<b>", Etnia, "</b><br>",
"Año: ", Año, "<br>",
"Casos: ", Casos)
)
# 3. GRÁFICO HEATMAP
g_heatmap <- ggplot(plot_data_heatmap, aes(x = factor(Año), y = reorder(Etnia, Total_Por_Etnia))) +
# Usamos Casos_Fill para el relleno (color), pero Tooltip_Text para el mouse
geom_tile(aes(fill = Casos_Fill, text = Tooltip_Text), color = "white", size = 0.2) +
# ESCALA DE COLORES
# na.value = "#f5f5f5": Esto pinta los NA (nuestros ceros) de un gris muy suave
scale_fill_viridis_c(
option = "magma",
direction = -1,
name = "Casos",
na.value = "#f5f5f5"
) +
scale_x_discrete(position = "top") +
labs(
title = "Mapa de Calor: Intensidad de casos por Etnia y Año",
subtitle = "El color aparece solo si hay al menos 1 caso registrado",
x = "",
y = ""
) +
theme_minimal() +
theme(
plot.title = element_text(face = "bold", size = 14, margin = margin(b=5)),
plot.subtitle = element_text(size = 10, color = "gray40", margin = margin(b=10)),
axis.text.x = element_text(face = "bold"),
axis.text.y = element_text(size = 9),
panel.grid = element_blank(),
legend.position = "right"
)
# 4. INTERACTIVIDAD
# Nota: Plotly por defecto hace los NA transparentes, lo cual funciona perfecto aquí.
ggplotly(g_heatmap, tooltip = "text", height = 900) %>%
layout(
margin = list(l = 150, t = 100),
xaxis = list(side = "top")
)